home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #225 (1993)(Rhein-Sieg-Soft).zip / Franz PD Disk #225 (1993)(Rhein-Sieg-Soft).adf / AMOSCopy / AMOSCopyV1_1a.AMOS / AMOSCopyV1_1a.amosSourceCode next >
AMOS Source Code  |  1993-03-05  |  32KB  |  1,429 lines
  1. '* ***************************************** * 
  2. '* Program:     AMOSCopy                     * 
  3. '* Version:     1.1a                         * 
  4. '* Copyright:   ï¿½1993 by Testaware           * 
  5. '* ----------------------------------------- * 
  6. '* Author:      Volker Stepprath             * 
  7. '*              Spandauerstr.4               * 
  8. '*              4019 / Monheim               * 
  9. '*              Germany                      * 
  10. '* ----------------------------------------- * 
  11. '* Language:    AMOS V1.31                   * 
  12. '* Compiler:    ACmp V1.0                    * 
  13. '* Copyright:   ï¿½1991 by Europress Software  * 
  14. '* ----------------------------------------- * 
  15. '* History:     1.0a / 1.0b / 1.1a           * 
  16. '* ----------------------------------------- * 
  17. '* Last update: New Option `RIPPER` / ABOUT  * 
  18. '*              removed !                    * 
  19. '* ----------------------------------------- * 
  20. '* Call:        WorkBench or CLI             * 
  21. '* ----------------------------------------- * 
  22. '* Programnote: Shareware ( Read DOC file )  * 
  23. '* ***************************************** * 
  24. '
  25. '
  26. '**** Variablen definieren ****
  27. Dim UPP(79),LOW(79)
  28. Global SOURCE,TARGET,VERIFY,ABORT,UPP,LOW,_DOIT
  29. Global UPP(),LOW(),XUPP,YUPP,XLOW,YLOW,UPPSIDE,LOWSIDE,RIP$
  30. SOURCE=0 : TARGET=1 : VERIFY=1 : OPTION=1 : UPPSIDE=1 : LOWSIDE=1
  31. For I=0 To 79
  32.   UPP(I)=1
  33.   LOW(I)=1
  34. Next I
  35. '
  36. Unpack 16 To 0
  37. Colour Back $779
  38. Change Mouse 4
  39. 'Erase 1 
  40. 'Erase 16
  41. 'Break Off 
  42. Request Off 
  43. Close Workbench 
  44. Set Dir 30,""
  45. Get Block 1,13,190,224,8
  46. _MESSAGE[""]
  47. Amos To Front 
  48. '
  49. '**** Speicher f�r Blockdaten reservieren **** 
  50. Reserve As Chip Data 7,1024
  51. '
  52. '**** Hauptschleife ( Men�abfrage ) **** 
  53. Do 
  54.   UPP=0 : LOW=0 : _DOIT=0 : XUPP=True : YUPP=0 : XLOW=True : YLOW=0 : ABORT=0
  55.   Wait 15 : Clear Key 
  56.   Repeat : Until Mouse Key=0
  57.   Repeat : MK=Mouse Key : Until MK
  58.   XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
  59.   '
  60.   '**** SOURCE & TARGET festlegen **** 
  61.   If XM>30 and XM<67
  62.     Ink 4,5
  63.     If YM>35 and YM<71
  64.       If MK=1
  65.         Add SOURCE,1,0 To 3
  66.       Else 
  67.         Add SOURCE,-1,0 To 3
  68.       End If 
  69.       Text 44,53,Str$(SOURCE)-" "
  70.     End If 
  71.     If YM>81 and YM<117
  72.       If MK=1
  73.         Add TARGET,1,0 To 3
  74.       Else 
  75.         Add TARGET,-1,0 To 3
  76.       End If 
  77.       Text 44,99,Str$(TARGET)-" "
  78.     End If 
  79.   End If 
  80.   '
  81.   '**** Disketteseiten modifizieren *****
  82.   If XM>82 and XM<184 and YM>57 and YM<156
  83.     _UPPERSIDE[XM,YM]
  84.   End If 
  85.   If XM>200 and XM<302 and YM>57 and YM<156
  86.     _LOWERSIDE[XM,YM]
  87.   End If 
  88.   '
  89.   '**** Verify ON / OFF **** 
  90.   If XM>37 and XM<71 and YM>147 and YM<157
  91.     If VERIFY
  92.       VERIFY=0
  93.       G[38,148,51,158,0]
  94.       G[53,148,70,158,1]
  95.     Else 
  96.       VERIFY=1
  97.       G[38,148,51,158,1]
  98.       G[53,148,70,158,0]
  99.     End If 
  100.   End If 
  101.   '
  102.   '**** Option festlegen ****
  103.   If XM>9 and XM<309 and YM>161 and YM<186
  104.     For I=0 To 6
  105.       G[10+I*43,162,50+I*43,172,0]
  106.       G[10+I*43,175,50+I*43,185,0]
  107.     Next I
  108.     Add XM,-9
  109.     XM=XM/43
  110.     If YM>161 and YM<173
  111.       OPTION=XM+1
  112.       G[10+XM*43,162,50+XM*43,172,1]
  113.     End If 
  114.     If YM>174 and YM<186
  115.       OPTION=XM+8
  116.       G[10+XM*43,175,50+XM*43,185,1]
  117.     End If 
  118.   End If 
  119.   '
  120.   '**** Option starten ****
  121.   If XM>9 and XM<40 and YM>134 and YM<146
  122.     G[10,135,39,145,1]
  123.     _CLEARSIDE[-1]
  124.     _MESSAGE[""]
  125.     Gosub "O"+Str$(OPTION)-" "
  126.     G[10,135,39,145,0]
  127.     Play 1,30,25
  128.   End If 
  129. Loop 
  130. '
  131. '**** DISKCopy ****
  132. O1:
  133.   If SOURCE=TARGET Then _DISKCOPYII Else _DISKCOPY
  134. Return 
  135. '**** Format ****
  136. O2:
  137.   _TRACK[1]
  138.   If ABORT=0 Then _TRACKBLOCK[0,-1]
  139. Return 
  140. '**** QFormat **** 
  141. O3:
  142.   N$="DF"+Str$(TARGET)-" "+":"
  143.   If Exist(N$)
  144.     Ink 1
  145.     _TRACKBLOCK[0,-1]
  146.     YUPP=0 : XUPP=0
  147.     _RASTER[0,0]
  148.     _TRACK[2]
  149.     YUPP=4 : XUPP=0
  150.     _RASTER[40,0]
  151.   Else 
  152.    _MESSAGE["No DOS disk in targetdrive !"]
  153.   End If 
  154. Return 
  155. '**** Erase **** 
  156. O4:
  157.   _TRACK[3]
  158. Return 
  159. '**** Check **** 
  160. O5:
  161.   _TRACK[4]
  162. Return 
  163. '**** Install **** 
  164. O6:
  165.   _TRACKBLOCK[0,-1]
  166. Return 
  167. '**** Block Edit ****
  168. O7:
  169.   _MESSAGE["Blocknumber (0-1758):"]
  170.   _TEXTINPUT[23]
  171.   BLOCK=Val(N$)
  172.   BLOCK=Min(1758,BLOCK)
  173.   _EDITBLOCK[BLOCK]
  174.   If Not ABORT Then _MESSAGE[""]
  175. Return 
  176. '**** Show RAW ****
  177. O8:
  178.   _MESSAGE["Tracknumber (0-79):"]
  179.   _TEXTINPUT[21]
  180.   TRACK=Val(N$)
  181.   TRACK=Min(79,TRACK)
  182.   _RAWSHOW[TRACK]
  183.   If Not ABORT Then _MESSAGE[""]
  184. Return 
  185. '**** Info ****
  186. O9:
  187.   N$="DF"+Str$(TARGET)-" "+":"
  188.   If Exist(N$)
  189.     Dir$=N$
  190.     N$=Dir$
  191.     N$=N$-":"
  192.     N$=Left$(N$,11)
  193.     _MESSAGE[N$+"  Free:"+Str$(Dfree)-" "+"  Mem:"+Str$(Chip Free+Fast Free)-" "]
  194.   Else 
  195.     _MESSAGE["No DOS disk in targetdrive !"]
  196.   End If 
  197. Return 
  198. '**** Dir **** 
  199. O10:
  200.   _DIR
  201. Return 
  202. '**** SYS Check **** 
  203. O11:
  204.   _SYSCHECK
  205. Return 
  206. '**** SYS Reset **** 
  207. O12:
  208.   _SYSRESET
  209. Return 
  210. '**** Ripper ****  
  211. O13:
  212.   _RIPPER
  213. Return 
  214. '**** Exit ****
  215. O14:
  216.   Erase 7
  217.   Request On 
  218.   If Exist("SYS:") Then Dir$="SYS:"
  219.   Wait 20
  220.   End 
  221.   'System
  222. Return 
  223. '
  224. '**** Diskettenseiten + Seitenoptionen ****
  225. Procedure _UPPERSIDE[XM,YM]
  226.   '
  227.   '**** UPPER Side BAM ****
  228.   If XM>82 and XM<183 and YM>57 and YM<146
  229.     Add XM,-83 : XM=XM/10
  230.     Add YM,-58 : YM=YM/11
  231.     TRACK=YM*10+XM
  232.     If UPP(TRACK)
  233.       UPP(TRACK)=0
  234.       G[83+XM*10,58+YM*11,92+XM*10,68+YM*11,0]
  235.     Else 
  236.       UPP(TRACK)=1
  237.       G[83+XM*10,58+YM*11,92+XM*10,68+YM*11,1]
  238.     End If 
  239.   End If 
  240.   '
  241.   If YM>146 and YM<156
  242.     '
  243.     '**** UPP On ****
  244.     If XM>83 and XM<95
  245.       G[83,147,96,155,1]
  246.       G[98,147,115,155,0]
  247.       UPPSIDE=1
  248.     End If 
  249.     '
  250.     '**** UPP Off **** 
  251.     If XM>97 and XM<116
  252.       G[83,147,96,155,0]
  253.       G[98,147,115,155,1]
  254.       UPPSIDE=0
  255.     End If 
  256.     '
  257.     '**** UPP Reverse **** 
  258.     If XM>117 and XM<150
  259.       G[117,147,149,155,1]
  260.       For I=0 To 79
  261.         If UPP(I)
  262.           UPP(I)=0
  263.         Else 
  264.           UPP(I)=1
  265.         End If 
  266.       Next I
  267.       For I=0 To 7
  268.         For I2=0 To 9
  269.           G[83+I2*10,58+I*11,92+I2*10,68+I*11,UPP(I3)]
  270.           Add I3,1
  271.         Next I2
  272.       Next I
  273.       I3=0
  274.       G[117,147,149,155,0]
  275.     End If 
  276.     '
  277.     '**** UPP Default **** 
  278.     If XM>150 and XM<183
  279.       G[151,147,182,155,1]
  280.       _CLEARSIDE[0]
  281.       For I=0 To 7
  282.         For I2=0 To 9
  283.           UPP(I3)=1
  284.           G[83+I2*10,58+I*11,92+I2*10,68+I*11,UPP(I3)]
  285.           Add I3,1
  286.         Next I2
  287.       Next I
  288.       I3=0
  289.       UPPSIDE=1
  290.       G[83,147,96,155,1]
  291.       G[98,147,115,155,0]
  292.       G[151,147,182,155,0]
  293.     End If 
  294.   End If 
  295. End Proc
  296. Procedure _LOWERSIDE[XM,YM]
  297.   '
  298.   '**** LOWER Side BAM ****
  299.   If XM>200 and XM<301 and YM>57 and YM<146
  300.     Add XM,-201 : XM=XM/10
  301.     Add YM,-58 : YM=YM/11
  302.     TRACK=YM*10+XM
  303.     If LOW(TRACK)
  304.       LOW(TRACK)=0
  305.       G[201+XM*10,58+YM*11,210+XM*10,68+YM*11,0]
  306.     Else 
  307.       LOW(TRACK)=1
  308.       G[201+XM*10,58+YM*11,210+XM*10,68+YM*11,1]
  309.     End If 
  310.   End If 
  311.   If YM>146 and YM<156
  312.     '
  313.     '**** LOW On ****
  314.     If XM>201 and XM<215
  315.       G[201,147,214,155,1]
  316.       G[216,147,233,155,0]
  317.       LOWSIDE=1
  318.     End If 
  319.     '
  320.     '**** LOW Off **** 
  321.     If XM>215 and XM<234
  322.       G[201,147,214,155,0]
  323.       G[216,147,233,155,1]
  324.       LOWSIDE=0
  325.     End If 
  326.     '
  327.     '**** LOW Reverse **** 
  328.     If XM>235 and XM<268
  329.       G[235,147,267,155,1]
  330.       For I=0 To 79
  331.         If LOW(I)
  332.           LOW(I)=0
  333.         Else 
  334.           LOW(I)=1
  335.         End If 
  336.       Next I
  337.       For I=0 To 7
  338.         For I2=0 To 9
  339.           G[201+I2*10,58+I*11,210+I2*10,68+I*11,LOW(I3)]
  340.           Add I3,1
  341.         Next I2
  342.       Next I
  343.       I3=0
  344.       G[235,147,267,155,0]
  345.     End If 
  346.     '
  347.     '**** LOW Default **** 
  348.     If XM>268 and XM<301
  349.       G[269,147,300,155,1]
  350.       _CLEARSIDE[1]
  351.       For I=0 To 7
  352.         For I2=0 To 9
  353.           LOW(I3)=1
  354.           G[201+I2*10,58+I*11,210+I2*10,68+I*11,LOW(I3)]
  355.           Add I3,1
  356.         Next I2
  357.       Next I
  358.       I3=0
  359.       LOWSIDE=1
  360.       G[201,147,214,155,1]
  361.       G[216,147,233,155,0]
  362.       G[269,147,300,155,0]
  363.     End If 
  364.   End If 
  365. End Proc
  366. Procedure _CLEARSIDE[N]
  367.   Ink 0
  368.   For I=0 To 7
  369.     For I2=0 To 9
  370.       If N=0 or N<0
  371.         Bar 84+I2*10,59+I*11 To 91+I2*10,67+I*11
  372.       End If 
  373.       If N or N<0
  374.         Bar 202+I2*10,59+I*11 To 209+I2*10,67+I*11
  375.       End If 
  376.     Next I2
  377.   Next I
  378. End Proc
  379. '**** Track kopieren ****
  380. Procedure _DISKCOPY
  381.   '
  382.   Reserve As Chip Data 2,5632
  383.   '
  384.   '**** Variablen & Adressen definieren **** 
  385.   DISKREP$=Space$(40)+Chr$(0)
  386.   DEVNAME$="trackdisk.device"+Chr$(0)
  387.   DISKREP=Varptr(DISKREP$)
  388.   '
  389.   IOREQ$=Space$(80)+Chr$(0)
  390.   IOREQADR=Varptr(IOREQ$)
  391.   '
  392.   IOREQ2$=Space$(80)+Chr$(0)
  393.   IOREQADR2=Varptr(IOREQ2$)
  394.   '
  395.   '**** Eigene Taskadresse suchen **** 
  396.   Areg(0)=0
  397.   Areg(1)=0
  398.   Dreg(0)=0
  399.   Dreg(1)=0
  400.   XFINDTASK=Execall(-294)
  401.   Loke DISKREP+$10,XFINDTASK
  402.   '
  403.   '**** Device ï¿½ffnen I & II ****
  404.   Areg(0)=Varptr(DEVNAME$)
  405.   '
  406.   Areg(1)=IOREQADR
  407.   Dreg(0)=SOURCE
  408.   XOPENDEVICE=Execall(-444)
  409.   If XOPENDEVICE<>0 Then _MESSAGE["Sourcedrive not available !"] : Goto _BYE
  410.   '
  411.   Areg(1)=IOREQADR2
  412.   Dreg(0)=TARGET
  413.   XOPENDEVICE=Execall(-444)
  414.   If XOPENDEVICE<>0 Then _MESSAGE["Targetdrive not available !"] : Goto _BYE
  415.   '
  416.   '**** Befehl aufrufen **** 
  417.   Loke IOREQADR+14,DISKREP
  418.   Loke IOREQADR+40,Start(2)
  419.   Loke IOREQADR+36,5632
  420.   Doke IOREQADR+28,2
  421.   '
  422.   Loke IOREQADR2+14,DISKREP
  423.   Loke IOREQADR2+40,Start(2)
  424.   Loke IOREQADR2+36,5632
  425.   Doke IOREQADR2+28,11
  426.   '
  427.   Gosub _DISKCOPY
  428.   '
  429.   '**** Motor ausschalten I & II ****
  430.   Areg(1)=IOREQADR
  431.   Doke IOREQADR+28,9
  432.   Loke IOREQADR+36,0
  433.   XDOIO=Execall(-456)
  434.   Areg(1)=IOREQADR2
  435.   Doke IOREQADR2+28,9
  436.   Loke IOREQADR2+36,0
  437.   XDOIO=Execall(-456)
  438.   '
  439.   '**** Device schlie�en I & II **** 
  440.   Areg(1)=IOREQADR
  441.   XCLOSEDEVICE=Execall(-450)
  442.   Areg(1)=IOREQADR2
  443.   XCLOSEDEVICE=Execall(-450)
  444.   '
  445. _BYE:
  446.   Erase 2
  447.   Pop Proc
  448.   '
  449. _DISKCOPY:
  450.   UL=-1
  451.   '  
  452.   For TRACK=0 To 159
  453.     Add UL,1,0 To 1
  454.     _BAMCHECK[UL]
  455.     If _DOIT
  456.       '
  457.       '**** Track einlesen ****
  458.       Ink 1,0
  459.       Areg(1)=IOREQADR
  460.       Loke IOREQADR+44,TRACK*5632
  461.       XDOIO=Execall(-456)
  462.       _LESETEST[TRACK,XDOIO]
  463.       '
  464.       '**** Track schreiben **** 
  465.       Areg(1)=IOREQADR2
  466.       Loke IOREQADR2+40,Start(2)
  467.       Loke IOREQADR2+44,TRACK*5632
  468.       XDOIO=Execall(-456)
  469.       _RASTER[TRACK,XDOIO]
  470.       '
  471.       '**** Verify ****
  472.       If VERIFY and ABORT=0
  473.         Doke IOREQADR2+28,2
  474.         XDOIO=Execall(-456)
  475.         _VERIFY[TRACK,XDOIO]
  476.         Doke IOREQADR2+28,11
  477.       End If 
  478.     End If 
  479.     '
  480.     '**** Abbruch ? **** 
  481.     If Mouse Key<>0
  482.       _ABORT
  483.     End If 
  484.     If ABORT : TRACK=159 : End If 
  485.     '
  486.   Next TRACK
  487. Return 
  488. End Proc
  489. Procedure _DISKCOPYII
  490.   If Fast Free+Chip Free<400000 Then _MESSAGE["Not enough memory !"] : Pop Proc
  491.   '
  492.   Reserve As Chip Data 2,225280
  493.   '
  494.   '**** Variablen & Adressen definieren **** 
  495.   DISKREP$=Space$(40)+Chr$(0)
  496.   DEVNAME$="trackdisk.device"+Chr$(0)
  497.   DISKREP=Varptr(DISKREP$)
  498.   '
  499.   IOREQ$=Space$(80)+Chr$(0)
  500.   IOREQADR=Varptr(IOREQ$)
  501.   '
  502.   '**** Eigene Taskadresse suchen **** 
  503.   Areg(0)=0
  504.   Areg(1)=0
  505.   Dreg(0)=0
  506.   Dreg(1)=0
  507.   XFINDTASK=Execall(-294)
  508.   Loke DISKREP+$10,XFINDTASK
  509.   '
  510.   '**** Device ï¿½ffnen I & II ****
  511.   Areg(0)=Varptr(DEVNAME$)
  512.   '
  513.   Areg(1)=IOREQADR
  514.   Dreg(0)=SOURCE
  515.   XOPENDEVICE=Execall(-444)
  516.   If XOPENDEVICE<>0 Then _MESSAGE["Sourcedrive not available !"] : Goto _BYE
  517.   '
  518.   '**** Befehl aufrufen **** 
  519.   Loke IOREQADR+14,DISKREP
  520.   Loke IOREQADR+40,Start(2)
  521.   Loke IOREQADR+36,5632
  522.   '
  523.   Gosub _DISKCOPY
  524.   '
  525. _ENDE:
  526.   '**** Motor ausschalten **** 
  527.   Areg(1)=IOREQADR
  528.   Doke IOREQADR+28,9
  529.   Loke IOREQADR+36,0
  530.   XDOIO=Execall(-456)
  531.   '
  532.   '**** Device schlie�en ****  
  533.   Areg(1)=IOREQADR
  534.   XCLOSEDEVICE=Execall(-450)
  535.   If Not ABORT Then _MESSAGE["Process finished !"]
  536.   '
  537. _BYE:
  538.   Erase 2
  539.   Pop Proc
  540.   '
  541. _DISKCOPY:
  542.   UL=True : UL2=True : N=True
  543.   '  
  544.   For TRACK=0 To 3
  545.     If N
  546.       Clear Key : _MESSAGE["Insert sourcedisk and press any key"] : Wait Key 
  547.       N=False : _MESSAGE[""]
  548.     End If 
  549.     '
  550.     '**** Track einlesen ****
  551.     For I=0 To 39
  552.       Add UL,1,0 To 1
  553.       _BAMCHECK[UL]
  554.       If _DOIT
  555.         N=True
  556.         Ink 2,0
  557.         Areg(1)=IOREQADR
  558.         Doke IOREQADR+28,2
  559.         Loke IOREQADR+40,Start(2)+5632*I
  560.         Loke IOREQADR+44,5632*((TRACK*40)+I)
  561.         XDOIO=Execall(-456)
  562.         _RASTER[TRACK*40+I,XDOIO]
  563.         _LESETEST[TRACK*40+I,XDOIO]
  564.         '
  565.         '**** Abbruch ? **** 
  566.         If Mouse Key<>0
  567.          _ABORT
  568.         End If 
  569.         If ABORT : Goto _ENDE : End If 
  570.       End If 
  571.     Next I
  572.     '
  573.     If N
  574.       '**** Motor ausschalten **** 
  575.       Areg(1)=IOREQADR
  576.       Doke IOREQADR+28,9
  577.       Loke IOREQADR+36,0
  578.       XDOIO=Execall(-456)
  579.       Loke IOREQADR+36,5632
  580.       '
  581.       Clear Key : _MESSAGE["Insert targetdisk and press any key"] : Wait Key 
  582.       _MESSAGE[""] : Add UPP,-20 : Add LOW,-20 : Add YUPP,-2 : Add YLOW,-2
  583.       For I2=0 To 39
  584.         Add UL2,1,0 To 1
  585.         _BAMCHECK[UL2]
  586.         If _DOIT
  587.           Ink 1,0
  588.           '**** Track schreiben **** 
  589.           Areg(1)=IOREQADR
  590.           Doke IOREQADR+28,11
  591.           Loke IOREQADR+40,Start(2)+5632*I2
  592.           Loke IOREQADR+44,5632*((TRACK*40)+I2)
  593.           XDOIO=Execall(-456)
  594.           If XDOIO=28 : _MESSAGE["Disk is write protected !"] : ABORT=True : Goto _ENDE : End If 
  595.           _RASTER[TRACK*40+I2,XDOIO]
  596.           '
  597.           '**** VERIFY ****
  598.           If VERIFY and ABORT=0
  599.             Doke IOREQADR+28,2
  600.             XDOIO=Execall(-456)
  601.             _VERIFY[TRACK*40+I2,XDOIO]
  602.           End If 
  603.           '
  604.           '**** Abbruch ? **** 
  605.           If Mouse Key<>0
  606.            _ABORT
  607.           End If 
  608.           If ABORT : Goto _ENDE : End If 
  609.         End If 
  610.       Next I2
  611.     End If 
  612.     '
  613.     '**** Motor ausschalten **** 
  614.     Areg(1)=IOREQADR
  615.     Doke IOREQADR+28,9
  616.     Loke IOREQADR+36,0
  617.     XDOIO=Execall(-456)
  618.     Loke IOREQADR+36,5632
  619.     '
  620. Next TRACK
  621. Return 
  622. End Proc
  623. '**** Block Einlesen / Schreiben ****
  624. Procedure _TRACKBLOCK[BLOCK,COMMAND]
  625.   '
  626.   '**** Variablen & Adressen definieren **** 
  627.   DISKREP$=Space$(40)+Chr$(0)
  628.   DEVNAME$="trackdisk.device"+Chr$(0)
  629.   IOREQ$=Space$(80)+Chr$(0)
  630.   DISKREP=Varptr(DISKREP$)
  631.   IOREQADR=Varptr(IOREQ$)
  632.   '
  633.   '**** BootBlock erstellen **** 
  634.   If COMMAND=-1
  635.     COMMAND=3
  636.     For I=0 To 1023
  637.       Poke Start(7)+I,0
  638.     Next I
  639.     For I=0 To 12
  640.       Read N
  641.       Loke Start(7)+I*4,N
  642.     Next I
  643.   End If 
  644.   '
  645.   '**** Eigene Taskadresse suchen **** 
  646.   Areg(0)=0
  647.   Areg(1)=0
  648.   Dreg(0)=0
  649.   Dreg(1)=0
  650.   XFINDTASK=Execall(-294)
  651.   Loke DISKREP+$10,XFINDTASK
  652.   '
  653.   '**** Device ï¿½ffnen **** 
  654.   Areg(0)=Varptr(DEVNAME$)
  655.   Areg(1)=IOREQADR
  656.   Dreg(0)=TARGET
  657.   Dreg(1)=0
  658.   XOPENDEVICE=Execall(-444)
  659.   If XOPENDEVICE<>0 Then _MESSAGE["Targetdrive not available !"] : ABORT=True : Pop Proc
  660.   '
  661.   '**** Devicekommando ausf�hren ****
  662.   Loke IOREQADR+14,DISKREP
  663.   Doke IOREQADR+28,COMMAND
  664.   Loke IOREQADR+40,Start(7)
  665.   Loke IOREQADR+36,1024
  666.   Loke IOREQADR+44,BLOCK*512
  667.   XDOIO=Execall(-456)
  668.   If XDOIO=29 Then _MESSAGE["No disk in targetdrive !"] : ABORT=True
  669.   '
  670.   '**** UPDATE[4] falls COMMAND=WRITE[3] ****
  671.   If COMMAND=3
  672.     Doke IOREQADR+28,4
  673.     XDOIO=Execall(-456)
  674.   End If 
  675.   '
  676.   '**** Motor ausschalten **** 
  677.   Doke IOREQADR+28,9
  678.   Loke IOREQADR+36,0
  679.   XDOIO=Execall(-456)
  680.   '
  681.   '**** Device schlie�en ****
  682.   XCLOSEDEVICE=Execall(-450)
  683.   '
  684.   '**** BootBlockDaten ****  
  685.   Data $444F5300,$C0200F19,$370,$43FA0018,$4EAEFFA0,$4A80670A
  686.   Data $20402068,$167000,$4E7570FF,$60FA646F,$732E6C69,$62726172,$79000000
  687. End Proc
  688. '**** Format / QFormat / Erase / Test **** 
  689. Procedure _TRACK[N]
  690.   '
  691.   Reserve As Chip Data 2,5632
  692.   '
  693.   '**** Variablen & Adressen definieren **** 
  694.   DISKREP$=Space$(40)+Chr$(0)
  695.   DEVNAME$="trackdisk.device"+Chr$(0)
  696.   IOREQ$=Space$(80)+Chr$(0)
  697.   DISKREP=Varptr(DISKREP$)
  698.   IOREQADR=Varptr(IOREQ$)
  699.   '
  700.   '**** Eigene Taskadresse suchen **** 
  701.   Areg(0)=0
  702.   Areg(1)=0
  703.   Dreg(0)=0
  704.   Dreg(1)=0
  705.   XFINDTASK=Execall(-294)
  706.   Loke DISKREP+$10,XFINDTASK
  707.   '
  708.   '**** Device ï¿½ffnen **** 
  709.   Areg(0)=Varptr(DEVNAME$)
  710.   Areg(1)=IOREQADR
  711.   Dreg(0)=TARGET
  712.   Dreg(1)=0
  713.   XOPENDEVICE=Execall(-444)
  714.   If XOPENDEVICE<>0 Then _MESSAGE["Targetdrive not available !"] : Goto _BYE
  715.   '
  716.   '**** Befehl aufrufen **** 
  717.   Loke IOREQADR+14,DISKREP
  718.   Loke IOREQADR+40,Start(2)
  719.   Loke IOREQADR+36,5632
  720.   Ink 1,0
  721.   On N Gosub _FORMAT,_QFORMAT,_ERASE,_TEST
  722.   '
  723.   '**** Motor ausschalten **** 
  724.   Doke IOREQADR+28,9
  725.   Loke IOREQADR+36,0
  726.   XDOIO=Execall(-456)
  727.   '
  728.   '**** Device schlie�en ****
  729.   XCLOSEDEVICE=Execall(-450)
  730.   '
  731. _BYE:
  732.   Erase 2
  733.   Pop Proc
  734.   '
  735.   '**** Track formattieren ****
  736. _FORMAT:
  737.   Doke IOREQADR+28,11
  738.   UL=-1
  739.   For TRACK=0 To 159
  740.     Add UL,1,0 To 1
  741.     _BAMCHECK[UL]
  742.     If _DOIT
  743.       Loke IOREQADR+44,TRACK*5632
  744.       XDOIO=Execall(-456)
  745.       _RASTER[TRACK,XDOIO]
  746.       '
  747.       '**** Verify ****
  748.       If VERIFY and ABORT=0
  749.         Doke IOREQADR+28,2
  750.         XDOIO=Execall(-456)
  751.         _VERIFY[TRACK,XDOIO]
  752.         Doke IOREQADR+28,11
  753.         Ink 1
  754.       End If 
  755.     End If 
  756.     '
  757.     '**** Abbruch ? **** 
  758.     If Mouse Key<>0
  759.       _ABORT
  760.     End If 
  761.     If ABORT : TRACK=159 : End If 
  762.     '
  763.   Next TRACK
  764.   If UPP(40) and ABORT=0
  765.     Gosub _QFORMAT
  766.   End If 
  767. Return 
  768. '
  769. _QFORMAT:
  770.   Doke IOREQADR+28,11
  771.   N=Start(2)
  772.   For I=$204 To $2DF
  773.     Poke N+I,$FF
  774.   Next I
  775.   Doke N+2,$2
  776.   Poke N+15,$48
  777.   Loke N+20,$A661AEF3
  778.   Doke N+$13A,$1
  779.   Doke N+$13E,$371
  780.   Poke N+$1B0,$5
  781.   Poke N+$1B1,$45
  782.   Poke N+$1B2,$4D
  783.   Poke N+$1B3,$50
  784.   Poke N+$1B4,$54
  785.   Poke N+$1B5,$59
  786.   Poke N+$1FF,$1
  787.   Loke N+$200,$C000C037
  788.   Poke N+$272,$3F
  789.   Poke N+$2DC,$3F
  790.   Loke IOREQADR+44,$6E000
  791.   XDOIO=Execall(-456)
  792. Return 
  793. '
  794. _ERASE:
  795.   Doke IOREQADR+28,17
  796.   UL=-1
  797.   For TRACK=0 To 159
  798.     Add UL,1,0 To 1
  799.     _BAMCHECK[UL]
  800.     If _DOIT
  801.       Loke IOREQADR+44,TRACK
  802.       XDOIO=Execall(-456)
  803.       _RASTER[TRACK,XDOIO]
  804.     End If 
  805.     '
  806.     '**** Abbruch ? **** 
  807.     If Mouse Key<>0
  808.       _ABORT
  809.     End If 
  810.     If ABORT : TRACK=159 : End If 
  811.     '
  812.   Next TRACK
  813. Return 
  814.   '
  815.   '**** Track testen ****
  816. _TEST:
  817.   Doke IOREQADR+28,2
  818.   UL=-1
  819.   For TRACK=0 To 159
  820.     Add UL,1,0 To 1
  821.     _BAMCHECK[UL]
  822.     If _DOIT
  823.       Loke IOREQADR+44,TRACK*5632
  824.       XDOIO=Execall(-456)
  825.       Ink 1
  826.       _RASTER[TRACK,XDOIO]
  827.     End If 
  828.     '
  829.     '**** Abbruch ? **** 
  830.     If Mouse Key<>0
  831.       _ABORT
  832.     End If 
  833.     If ABORT : TRACK=159 : End If 
  834.     '
  835.   Next TRACK
  836. Return 
  837. '
  838. End Proc
  839. '**** Block edieren **** 
  840. Procedure _EDITBLOCK[BLOCK]
  841.   Erase 7
  842.   Reserve As Chip Data 7,1024
  843.   _TRACKBLOCK[BLOCK,2]
  844.   If ABORT Then Pop Proc
  845.   Screen Open 1,624,168,4,Hires
  846.   Screen To Back 
  847.   Flash Off 
  848.   Cls 0
  849.   Get Palette 0
  850.   Colour 3,$FFF
  851.   Screen Display 1,112,81,,
  852.   Pen 2 : Paper 0
  853.   Ink 2,0
  854.   Text 102,164,"ASC:" : Text 194,164,"HEX:"
  855.   Text 289,164,"POS: "+Hex$(0,8)
  856.   G[89,155,177,167,0] : G[181,155,269,167,0]
  857.   G[273,155,415,167,0]
  858.   G[419,155,507,167,0] : G[511,155,599,167,0]
  859.   Text 448,164,"Save" : Text 536,164,"Abort"
  860.   Locate 35,1 : Print "Block #";Str$(BLOCK)-" "+" & #"+Str$(BLOCK+1)-" "
  861.   Curs Off 
  862.   For I=1 To 16
  863.     N$=""
  864.     For I2=1 To 64
  865.       N=Peek(Start(7)+I3)
  866.       If N<32 or(N>127 and N<161) Then N=46
  867.       N$=N$+Chr$(N)
  868.       Add I3,1
  869.     Next I2
  870.     Locate 11,2+I : Print N$
  871.   Next I
  872.   Curs Off 
  873.   Clear Key 
  874.   XC=11 : YC=3
  875.   Gosub _ASCHEXPOS
  876.   N=%11111111 : Set Curs N,0,0,0,0,0,0,N
  877.   Locate XC,YC : Curs On : Pen 1
  878.   Screen To Front 
  879.   Do 
  880.     Repeat 
  881.       Clear Key 
  882.       N=0
  883.       N2=0
  884.       While N=0 and N2=0 : N2=Mouse Key : N=Asc(Inkey$) : Wend 
  885.       If N and N2=0
  886.         If N=28 and XC<74 : Inc XC : End If 
  887.         If N=29 and XC>11 : Dec XC : End If 
  888.         If N=30 and YC>3 : Dec YC : End If 
  889.         If N=31 and YC<18 : Inc YC : End If 
  890.         If N>31
  891.           N2=(YC-3)*64+(XC-11)
  892.           Print Chr$(N)
  893.           Curs Off 
  894.           Poke Start(7)+N2,N
  895.         End If 
  896.         Gosub _ASCHEXPOS
  897.         Locate XC,YC
  898.         Curs On 
  899.       End If 
  900.     Until Mouse Key>0
  901.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
  902.     If YM>154 and YM<168
  903.       If XM>87 and XM<178
  904.         G[89,155,177,167,1]
  905.         Gosub _TXTEINGABE
  906.         Gosub _ASCHEXPOS
  907.         G[89,155,177,167,0]
  908.       End If 
  909.       If XM>418 and XM<508
  910.         G[419,155,507,167,1]
  911.         _TRACKBLOCK[BLOCK,3]
  912.         G[419,155,507,167,0]
  913.       End If 
  914.       If XM>510 and XM<600
  915.         G[511,155,599,167,1]
  916.         Wait 20
  917.         Exit 1
  918.       End If 
  919.     End If 
  920.   Loop 
  921.   Screen Close 1
  922.   Pop Proc
  923. _ASCHEXPOS:
  924.   N$=""
  925.   Ink 2
  926.   N2=(YC-3)*64+(XC-11)
  927.   N=Peek(Start(7)+N2)
  928.   If N<10 : N$="00" : End If 
  929.   If N<100 and N>9 : N$="0" : End If 
  930.   N$=N$+Str$(N)-" "
  931.   Text 142,164,N$
  932.   Text 234,164,Hex$(N,2)
  933.   Text 329,164,Hex$(BLOCK*512+N2,8)
  934.   N=0
  935. Return 
  936. _TXTEINGABE:
  937.   N$=""
  938.   Ink 0 : Bar 142,156 To 170,164
  939.   Ink 1
  940.   Repeat 
  941.     N=0
  942.     Clear Key : Wait 10
  943.     While N=0 : N=Asc(Inkey$) : Wend 
  944.     If N>47 and N<58 and Len(N$)<3
  945.       N$=N$+Chr$(N)
  946.       Text 142,164,N$
  947.     End If 
  948.   Until N=13 or Len(N$)=3
  949.   N=Min(255,Val(N$))
  950.   N2=(YC-3)*64+(XC-11)
  951.   Poke Start(7)+N2,N
  952.   If N<31 or(N>127 and N<160)
  953.     N=46
  954.   End If 
  955.   Print Chr$(N);
  956.   Locate XC,YC
  957. Return 
  958. End Proc
  959. '**** Zeige Trackdaten in Rawformat **** 
  960. Procedure _RAWSHOW[TRACK]
  961.   '
  962.   Reserve As Chip Data 2,$3A70
  963.   '
  964.   '**** Variablen & Adressen definieren **** 
  965.   DISKREP$=Space$(40)+Chr$(0)
  966.   DEVNAME$="trackdisk.device"+Chr$(0)
  967.   DISKREP=Varptr(DISKREP$)
  968.   '
  969.   IOREQ$=Space$(80)+Chr$(0)
  970.   IOREQADR=Varptr(IOREQ$)
  971.   '
  972.   '**** Eigene Taskadresse suchen **** 
  973.   Areg(0)=0
  974.   Areg(1)=0
  975.   Dreg(0)=0
  976.   Dreg(1)=0
  977.   XFINDTASK=Execall(-294)
  978.   Loke DISKREP+$10,XFINDTASK
  979.   '
  980.   '**** Device ï¿½ffnen **** 
  981.   Areg(0)=Varptr(DEVNAME$)
  982.   Areg(1)=IOREQADR
  983.   Dreg(0)=TARGET
  984.   XOPENDEVICE=Execall(-444)
  985.   If XOPENDEVICE<>0 Then _MESSAGE["Targetdrive not available !"] : ABORT=True : Goto _BYE
  986.   '
  987.   '**** Befehl aufrufen **** 
  988.   Loke IOREQADR+14,DISKREP
  989.   Loke IOREQADR+40,Start(2)
  990.   Loke IOREQADR+36,$397C
  991.   Doke IOREQADR+28,16
  992.   Poke IOREQADR+30,1
  993.   Areg(1)=IOREQADR
  994.   Loke IOREQADR+44,TRACK
  995.   XDOIO=Execall(-456)
  996.   If XDOIO=29 Then _MESSAGE["No disk in targetdrive !"] : ABORT=True
  997.   '
  998.   '**** Motor ausschalten I & II ****
  999.   Areg(1)=IOREQADR
  1000.   Doke IOREQADR+28,9
  1001.   Loke IOREQADR+36,0
  1002.   XDOIO=Execall(-456)
  1003.   '
  1004.   '**** Device schlie�en I & II **** 
  1005.   Areg(1)=IOREQADR
  1006.   XCLOSEDEVICE=Execall(-450)
  1007.   '
  1008.   If ABORT Then Goto _BYE
  1009.   Gosub _RAWSHOW
  1010.   '
  1011.   Screen Close 1
  1012.   '
  1013. _BYE:
  1014.   Erase 2
  1015.   Pop Proc
  1016.   '
  1017. _RAWSHOW:
  1018.   '
  1019.   '**** Track in RAW Format zeigen ****
  1020.   N=Start(2)
  1021.   Screen Open 1,640,168,4,Hires
  1022.   Flash Off : Cls 0 : Get Palette 0
  1023.   Screen Display 1,128,81,,
  1024.   Pen 2 : Paper 0 : I=0
  1025.   Gosub _RAW
  1026.   Do 
  1027.     UL=0 : Clear Key 
  1028.     Repeat : UL=Asc(Inkey$) : Until UL
  1029.     If UL=28 or UL=31 Then Add I,1,0 To 10 : Gosub _RAW
  1030.     If UL=29 or UL=30 Then Add I,-1,0 To 10 : Gosub _RAW
  1031.     If UL=27 or UL=32 Then Exit 
  1032.   Loop 
  1033. Return 
  1034. _RAW:
  1035.   Locate 0,1 : Cls 0 : Centre "Track:"+Str$(TRACK)+"  Sector:"+Str$(I)
  1036.   Locate 0,3 : Curs Off 
  1037.   For I2=0 To 1359
  1038.     N2=Peek(N+I*1360+I2)
  1039.     If N2<32 or N2>127 and N2<161 Then N2=46
  1040.     Print Chr$(N2);
  1041.   Next I2
  1042. Return 
  1043. End Proc
  1044. '**** Directory ausgabe **** 
  1045. Procedure _DIR
  1046.   N$="DF"+Str$(TARGET)-" "+":"
  1047.   If Exist(N$)
  1048.     Screen Open 1,320,176,4,Lowres
  1049.     Screen To Back 
  1050.     Screen Display 1,144,82,,
  1051.     Flash Off 
  1052.     Get Palette 0
  1053.     Cls 0
  1054.     Dir$=N$
  1055.     Pen 1 : Paper 0 : Print "Directory of ";Dir$
  1056.     N$=Dir First$("")
  1057.     Pen 2 : Print N$
  1058.     Screen To Front 
  1059.     I=1
  1060.     While N$<>""
  1061.       Inc I
  1062.       If I<20
  1063.         N$=Dir Next$
  1064.         Print N$
  1065.       Else 
  1066.         Pen 1 : Print "press any key" : Curs Off : Wait Key 
  1067.         Pen 2
  1068.         I=0
  1069.       End If 
  1070.     Wend 
  1071.     Pen 1 : Print "press any key" : Curs Off : Wait Key 
  1072.     Screen Close 1
  1073.   Else 
  1074.     _MESSAGE["No DOS disk in targetdrive !"]
  1075.   End If 
  1076. End Proc
  1077. '**** Vektoren nach Viren testen ****
  1078. Procedure _SYSCHECK
  1079.   EXECBASE=4
  1080.   EXECBASE=Leek(EXECBASE)
  1081.   For I=0 To 4
  1082.     Read N$,OFFSET
  1083.     N=EXECBASE+OFFSET
  1084.     N=Leek(N)
  1085.     If N
  1086.       Colour Back $F00 : Screen Show 
  1087.       Fade 1,$F00 : Wait 70
  1088.       _MESSAGE[N$+" is abnormal: "+Hex$(N,8)]
  1089.       Colour Back $779 : Screen Show 
  1090.       Fade 1,$779 : Wait 15
  1091.       Pop Proc
  1092.     End If 
  1093.   Next 
  1094.   _MESSAGE["No abnormal vector !"]
  1095.   Data "ColdCapture",$2A
  1096.   Data "CoolCapture",$2E
  1097.   Data "WarmCapture",$32
  1098.   Data "KickMemPtr",$222
  1099.   Data "KickTagPtr",$226
  1100. End Proc
  1101. '**** Virus l�schen **** 
  1102. Procedure _SYSRESET
  1103.   For I=0 To 109 : Read N : N$=N$+Chr$(N) : Next I
  1104.   Call Varptr(N$)
  1105.   Data 51,252,64,0,0,223,240,154,44,120
  1106.   Data 0,4,32,86,145,252,0,0,2,118
  1107.   Data 48,60,33,0,66,152,81,200,255,252
  1108.   Data 32,124,0,0,0,0,48,60,0,254
  1109.   Data 66,152,81,200,255,252,61,124,170,170
  1110.   Data 0,36,45,124,204,204,204,204,0,38
  1111.   Data 45,124,0,48,0,0,0,62,45,124
  1112.   Data 0,222,0,0,0,78,45,124,187,187
  1113.   Data 187,187,0,82,45,124,221,221,221,221
  1114.   Data 2,42,32,124,1,0,0,0,34,124
  1115.   Data 0,255,255,236,36,81,145,202,78,208
  1116. End Proc
  1117. '**** Datenklau ( Illegal ) **** 
  1118. Procedure _RIPPER
  1119.   '
  1120.   On Error Goto FEHLER
  1121.   '
  1122.   Do 
  1123.     '
  1124.     Erase 8
  1125.     _MESSAGE[""]
  1126.     Put Block 1,49,190
  1127.     E=0 : TASTE=0
  1128.     Wait 60 : Clear Key 
  1129.     While Mouse Key<>0 : Wend 
  1130.     While Mouse Key=0 and TASTE=0 : TASTE=Asc(Inkey$) : Wend 
  1131.     X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
  1132.     If TASTE : X=0 : Y=0 : End If 
  1133.     If Y>189 and Y<199 or TASTE
  1134.       '
  1135.       If X>48 and X<90 or TASTE=49
  1136.         G[49,190,89,197,1] : Wait 20
  1137.         _MESSAGE[""]
  1138.         _MESSAGE["Enter string:"]
  1139.         _TEXTINPUT[15]
  1140.         If RIP$="" : Goto _FEHLER : End If 
  1141.         _MESSAGE[""]
  1142.         N$=RIP$
  1143.         _MESSAGE["Enter startblock:"]
  1144.         _TEXTINPUT[19]
  1145.         _MESSAGE[""]
  1146.         N=Val(RIP$)
  1147.         N=Abs(N)
  1148.         N=Min(1759,N)
  1149.         _MESSAGE["Searching in block #"+Str$(N)-" "]
  1150.         For I=N To 1759
  1151.           Text 175,196,Str$(I)-" "
  1152.           _TRACKBLOCK[I,2]
  1153.           F=Hunt(Start(7) To Start(7)+512,N$)
  1154.           If F : N=I : I=1759 : End If 
  1155.           If Inkey$<>"" : I=1759 : End If 
  1156.         Next I
  1157.         _MESSAGE[""]
  1158.         If F
  1159.           Add F,-Start(7)
  1160.           _MESSAGE["String in block #"+Str$(N)-" "+"  POS:"+Hex$(N*512+F,8)]
  1161.         Else 
  1162.           _MESSAGE["String not found !"]
  1163.         End If 
  1164.       End If 
  1165.       '
  1166.       If X>91 and X<160 or TASTE=50
  1167.         G[92,190,159,197,1] : Wait 20
  1168.         _MESSAGE[""]
  1169.         _MESSAGE["Enter startblock:"]
  1170.         _TEXTINPUT[19]
  1171.         A=Val(RIP$)
  1172.         A=Abs(A)
  1173.         A=Min(1759,A)
  1174.         _MESSAGE[""]
  1175.         _MESSAGE["Enter endblock:"]
  1176.         _TEXTINPUT[17]
  1177.         B=Val(RIP$)
  1178.         B=Abs(B)
  1179.         B=Min(1759,B)
  1180.         If A>B : Swap A,B : End If 
  1181.         '
  1182.         Gosub _TESTDRIVE
  1183.         If E : Goto _FEHLER : End If 
  1184.         N$=Fsel$("","","Choose outputfile !")
  1185.         '
  1186.         If N$<>""
  1187.           Open Out 1,N$
  1188.             If E : Goto _FEHLER : End If 
  1189.             _MESSAGE["Working block #"+Str$(A)-" "]
  1190.             For I=A To B
  1191.               Text 134,196,Str$(I)-" "
  1192.               _TRACKBLOCK[I,2]
  1193.               For I2=0 To 511
  1194.                 A$=A$+Chr$(Peek(Start(7)+I2))
  1195.               Next I2
  1196.               Print #1,A$;
  1197.               A$=""
  1198.             Next I
  1199.           Close 1
  1200.           _MESSAGE[""]
  1201.           _MESSAGE["Proccess finished !"]
  1202.         Else 
  1203.           Goto _FEHLER
  1204.         End If 
  1205.       End If 
  1206.       '  
  1207.       If X>161 and X<201 or TASTE=51
  1208.         G[162,190,200,197,1] : Wait 20
  1209.         _MESSAGE[""]
  1210.         _MESSAGE["Enter string:"]
  1211.         _TEXTINPUT[15]
  1212.         If RIP$="" : Goto _FEHLER : End If 
  1213.         '
  1214.         Gosub _TESTDRIVE
  1215.         If E : Goto _FEHLER : End If 
  1216.         N$=Fsel$("","","Choose file for left cut !")
  1217.         '
  1218.         If N$<>""
  1219.           If Exist(N$)
  1220.             Open In 1,N$
  1221.               N=Lof(1)
  1222.             Close 1
  1223.             Reserve As Data 8,N
  1224.             Bload N$,Start(8)
  1225.             F=Hunt(Start(8) To Start(8)+Length(8),RIP$)
  1226.             If F
  1227.               N$=Fsel$("","","Choose outputfile !")
  1228.               If N$<>""
  1229.                 Bsave N$,Start(8)+(F-Start(8)) To Start(8)+Length(8)
  1230.                 If E=0 : Goto _FEHLER : End If 
  1231.               End If 
  1232.             Else 
  1233.               _MESSAGE["String not found !"]
  1234.             End If 
  1235.           Else 
  1236.             _MESSAGE["File not found !"]
  1237.           End If 
  1238.         Else 
  1239.           Goto _FEHLER
  1240.         End If 
  1241.       End If 
  1242.       '
  1243.       If X>202 and X<244 or TASTE=52
  1244.         G[203,190,243,197,1] : Wait 20
  1245.         _MESSAGE[""]
  1246.         _MESSAGE["Enter string:"]
  1247.         _TEXTINPUT[15]
  1248.         If RIP$="" : Goto _FEHLER : End If 
  1249.         '
  1250.         Gosub _TESTDRIVE
  1251.         If E : Goto _FEHLER : End If 
  1252.         N$=Fsel$("","","Choose file for right cut !")
  1253.         '
  1254.         If N$<>""
  1255.           If Exist(N$)
  1256.             Open In 1,N$
  1257.               N=Lof(1)
  1258.             Close 1
  1259.             Reserve As Data 8,N
  1260.             Bload N$,Start(8)
  1261.             I=Start(8)
  1262.             Repeat 
  1263.               F=Hunt(I+1 To Start(8)+Length(8)+1,RIP$)
  1264.               If F
  1265.                 I=F
  1266.               End If 
  1267.             Until F=0
  1268.             If I and I<>Start(8)
  1269.               N$=Fsel$("","","Choose outputfile !")
  1270.               If N$<>""
  1271.                 Bsave N$,Start(8) To I
  1272.                 If E=0 : Goto _FEHLER : End If 
  1273.               End If 
  1274.             Else 
  1275.               _MESSAGE["String not found !"]
  1276.             End If 
  1277.           Else 
  1278.             _MESSAGE["File not found !"]
  1279.           End If 
  1280.         Else 
  1281.           Goto _FEHLER
  1282.         End If 
  1283.       End If 
  1284.       '  
  1285.       If X>245 and X<272 or TASTE=53
  1286.         G[246,190,271,197,1] : Wait 20
  1287.         _MESSAGE[""]
  1288.         Pop Proc
  1289.       End If 
  1290.     End If 
  1291.     Clear Key 
  1292.     While Mouse Key=0 and Asc(Inkey$)=0 : Wend 
  1293.     _FEHLER:
  1294.     '
  1295.   Loop 
  1296.   '
  1297.   FEHLER:
  1298.     E=Errn
  1299.     _MESSAGE["Error #"+Str$(E)-" "+" occured !"]
  1300.     Clear Key 
  1301.     While Mouse Key=0 and Asc(Inkey$)=0 : Wend 
  1302.   Resume Next 
  1303.   '
  1304.   _TESTDRIVE:
  1305.     _MESSAGE[""]
  1306.     If Exist("DF0:") Then Dir$="DF0:" : Return 
  1307.     If Exist("DF1:") Then Dir$="DF1:" : Return 
  1308.     If Exist("DF2:") Then Dir$="DF2:" : Return 
  1309.     If Exist("DF3:") Then Dir$="DF3:" : Return 
  1310.     If Exist("RAM:") Then Dir$="RAM:" : Return 
  1311.     _MESSAGE[""]
  1312.     _MESSAGE["No DOS disk available !"]
  1313.     E=True
  1314.     Clear Key 
  1315.     While Mouse Key=0 and Asc(Inkey$)=0 : Wend 
  1316.   Return 
  1317.   '
  1318. End Proc
  1319. '**** Texteingabe **** 
  1320. Procedure _TEXTINPUT[N]
  1321.   Shared N$
  1322.   N$=""
  1323.   Do 
  1324.     Clear Key 
  1325.     N2=0
  1326.     While N2=0 : N2=Asc(Inkey$) : Wend 
  1327.     Exit If N2=13
  1328.     If N2<>8 and Len(N$)+N<37
  1329.        N$=N$+Chr$(N2)
  1330.     End If 
  1331.     If N2=8
  1332.       If Len(N$)>0
  1333.         N$=Left$(N$,Len(N$)-1)
  1334.       End If 
  1335.     End If 
  1336.     Text N*8,196,N$+" "
  1337.   Loop 
  1338.   RIP$=N$
  1339. End Proc
  1340. '**** Trackanzeige ****
  1341. Procedure _RASTER[TRACK,XDOIO]
  1342.   N=TRACK mod 2
  1343.   If XDOIO
  1344.     Ink 2
  1345.     Add XDOIO,-19
  1346.     If XDOIO>8
  1347.       If XDOIO=9 : N$="Disk is write protected !" : End If 
  1348.       If XDOIO=10 : N$="No disk in drive !" : End If 
  1349.       _MESSAGE[N$]
  1350.       ABORT=True
  1351.       Pop Proc
  1352.     End If 
  1353.   End If 
  1354.   If N=0
  1355.     Text 84+XUPP*10,66+YUPP*11,Str$(XDOIO)-" "
  1356.   Else 
  1357.     Text 202+XLOW*10,66+YLOW*11,Str$(XDOIO)-" "
  1358.   End If 
  1359. End Proc
  1360. Procedure _VERIFY[TRACK,XDOIO]
  1361.   If XDOIO=0 Then Pop Proc
  1362.   N=TRACK mod 2
  1363.   Add XDOIO,-19
  1364.   _MESSAGE["Verify error ! ï¿½ ESC=Abort process ï¿½"]
  1365.   If N=0
  1366.     Text 84+XUPP*10,66+YUPP*11,Str$(XDOIO)-" "
  1367.   Else 
  1368.     Text 202+XLOW*10,66+YLOW*11,Str$(XDOIO)-" "
  1369.   End If 
  1370.   Repeat : N2=Asc(Inkey$) : Until N2
  1371.   _MESSAGE[""]
  1372.   If N2=27 Then ABORT=True
  1373. End Proc
  1374. Procedure _LESETEST[TRACK,XDOIO]
  1375.   If XDOIO=0 Then Pop Proc
  1376.   If XDOIO=29 : _RASTER[TRACK,29] : Pop Proc : End If 
  1377.   N=TRACK mod 2
  1378.   Add XDOIO,-19
  1379.   Ink 2
  1380.   If N=0
  1381.     Text 84+XUPP*10,66+YUPP*11,Str$(XDOIO)-" "
  1382.   Else 
  1383.     Text 202+XLOW*10,66+YLOW*11,Str$(XDOIO)-" "
  1384.   End If 
  1385.   _MESSAGE["Read error !  ï¿½ ESC=Abort process ï¿½"]
  1386.   Repeat : N2=Asc(Inkey$) : Until N2
  1387.   _MESSAGE[""]
  1388.   If N2=27 Then ABORT=True
  1389. End Proc
  1390. '**** Testen ob Track selektiert ****
  1391. Procedure _BAMCHECK[UL]
  1392.   If UL=0
  1393.     Add XUPP,1
  1394.     If XUPP=10
  1395.       Add YUPP,1 : XUPP=0
  1396.     End If 
  1397.     If UPP(UPP) and UPPSIDE : _DOIT=True Else _DOIT=False : End If 
  1398.     Inc UPP
  1399.   Else 
  1400.     If LOW(LOW) and LOWSIDE : _DOIT=True Else _DOIT=False : End If 
  1401.     Inc LOW
  1402.     Add XLOW,1
  1403.     If XLOW=10
  1404.       Add YLOW,1 : XLOW=0
  1405.     End If 
  1406.   End If 
  1407. End Proc
  1408. '**** Prozess vorzeitig beenden **** 
  1409. Procedure _ABORT
  1410.   XM=X Screen(X Mouse)
  1411.   YM=Y Screen(Y Mouse)
  1412.   If XM>40 and XM<72 and YM>134 and YM<146
  1413.     G[41,135,71,145,1]
  1414.     ABORT=True
  1415.     Wait 5
  1416.     G[41,135,71,145,0]
  1417.     _MESSAGE["Process aborted !"]
  1418.   End If 
  1419. End Proc
  1420. '**** Mitteilung ****
  1421. Procedure _MESSAGE[N$]
  1422.   Ink 0,0 : Bar 12,189 To 301,198
  1423.   Ink 2 : Text 14,196,N$
  1424. End Proc
  1425. '**** Schalter An / Aus **** 
  1426. Procedure G[X,Y,X2,Y2,S]
  1427.   If S Then C1=2 : C2=1 Else C1=1 : C2=2
  1428.   Ink C1 : Draw X,Y To X2-1,Y : Draw X,Y To X,Y2 : Ink C2 : Draw X+1,Y2 To X2,Y2 : Draw X2,Y To X2,Y2 : Ink 1,0
  1429. End Proc